home *** CD-ROM | disk | FTP | other *** search
/ Amiga Magazin: Amiga-CD 1997 May & June / Amiga-CD 1997 #5-6.iso / patches / finalwrapper3_13 / finalwrapper.rexx < prev    next >
OS/2 REXX Batch file  |  1997-02-15  |  52KB  |  2,501 lines
  1. /* $VER: FinalWrapper 3.13 (15.02.97) by NDY's */
  2. version="3.13"
  3. date="15.02.97"
  4. copyright="© 1997 Andreas Weiss"
  5. OPTIONS RESULTS
  6. SIGNAL ON ERROR
  7. SIGNAL ON SYNTAX
  8. SIGNAL ON BREAK_C
  9. ARG cliarg
  10. initerr=init()
  11. rxport=ADDRESS()
  12. IF ~(Left(rxport,Length(finalw))=finalw) THEN
  13. DO
  14. DO i=1 TO 20 UNTIL portok
  15. rxport=finalw||i
  16. portok=Show("p",rxport)
  17. END
  18. IF portok THEN ADDRESS VALUE rxport
  19. END
  20. portok=Show("p",rxport)
  21. CALL locale
  22. CALL checkenv
  23. CALL loaddef(1)
  24. IF portok THEN
  25. DO
  26. GetDocItemPrefs "DECIMAL"
  27. deci=Upper(RESULT)
  28. DocItemPrefs "DECIMAL PERIOD" 
  29. CALL options
  30. CALL chosenobjs
  31. CALL oval
  32. CALL scan
  33. CALL resetprefs
  34. END
  35. meas=measure.1
  36. IF portok THEN
  37. DO
  38. GetDisplayPrefs "MEASURE"
  39. RESULT=Upper(RESULT)
  40. SELECT
  41. WHEN RESULT="INCHES" THEN meas=measure.2
  42. WHEN RESULT="METRIC" THEN meas=measure.3
  43. WHEN RESULT="PICA" THEN meas=measure.4
  44. OTHERWISE NOP
  45. END
  46. END
  47. DO id=agads+1 TO agads+sgads
  48. ltxt.id=replacepat(ltxt.id,"@m",meas)
  49. END
  50. IF guiinit()=5 THEN CALL message(50,nogui)
  51. init=0
  52. DO FOREVER
  53. CALL OnMenu(win,1024)
  54. IF ~zoomed THEN CALL ZipWindow(win)
  55. CALL ScreenToFront(scr)
  56. CALL ActivateWindow(win)
  57. CALL SetWindowTitles(win,wintitle,scrtitle)
  58. IF Left(text,Min(len.tgad,Length(text)))~=val.tgad THEN text=val.tgad
  59. DO UNTIL portok
  60. closed=0
  61. DO UNTIL closed~=0
  62. DO UNTIL closed~=0
  63. CALL WaitPkt(portname)
  64. CALL messy
  65. END
  66. DO id=1 TO agads+sgads
  67. IF labs.id>0 THEN CALL checkstrgad
  68. END
  69. IF closed=winclose | closed=okclose & prefsstore THEN CALL savedef(1)
  70. IF closed=cancelclose | closed=winclose THEN
  71. DO
  72. CALL bye(0)
  73. closed=0
  74. END
  75. IF closed=rxclose THEN
  76. DO
  77. ADDRESS COMMAND "Run >NIL: Rx "||defdir
  78. closed=0
  79. END
  80. IF closed=nextclose THEN
  81. DO
  82. ADDRESS VALUE rxport
  83. portok=1
  84. CALL newdoc
  85. closed=0
  86. END
  87. END
  88. closed=0
  89. portok=Show("P",rxport)
  90. IF ~portok THEN
  91. DO
  92. DO i=1 TO 20 UNTIL portok
  93. rxport=finalw||i
  94. portok=Show("p",rxport)
  95. END
  96. CALL newdoc
  97. END
  98. IF ~portok THEN
  99. CALL message(0,nofw)
  100. ELSE
  101. ADDRESS VALUE rxport
  102. END
  103. zoomed=BitTst(D2C(GETVALUE(win,24,4,"N")),28)
  104. IF ~zoomed THEN CALL ZipWindow(win) 
  105. CALL SetWindowTitles(win,aborttitle,busytitle)
  106. ScreenToFront
  107. CALL OffMenu(win,1024)
  108. GetDocItemPrefs "DECIMAL"
  109. deci=Upper(RESULT)
  110. DocItemPrefs "DECIMAL PERIOD" 
  111. CALL options
  112. IF chosenobjs()=0 THEN
  113. DO
  114. CALL oval
  115. CALL scan
  116. IF closed=0 THEN CALL text
  117. IF closed=0 THEN CALL wrap
  118. IF closed=0 THEN CALL group
  119. CALL updategadgets
  120. IF stilltoreply THEN
  121. DO
  122. CALL Reply(replymsg,0)
  123. stilltoreply=0
  124. END
  125. END
  126. CALL resetprefs
  127. END
  128. CALL bye(5)
  129. rembad: PROCEDURE 
  130. PARSE ARG t
  131. bad=XRange("00"x,"1F"x)||XRange("7F"x,"A0"x)
  132. i=Verify(t,bad,"m")
  133. l=Length(t)
  134. DO WHILE i>0
  135. t=Left(t,i-1) Right(t,l-i)
  136. i=Verify(t,bad,"m")
  137. END
  138. RETURN t
  139. replacepat: PROCEDURE 
  140. PARSE ARG str,pat,replc
  141. p=Pos(pat,str)
  142. DO WHILE p>0
  143. str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
  144. p=Pos(pat,str)
  145. END
  146. RETURN str
  147. gettexttypespecs: PROCEDURE 
  148. Status "FONTSIZE"
  149. p="SIZE" RESULT
  150. Status "FONTWIDTH"
  151. p=p "WIDTH" RESULT
  152. Status "FONTOBLIQUE"
  153. p=p "OBLIQUE" RESULT
  154. RETURN p
  155. radius: PROCEDURE 
  156. ARG a,rx,ry,v
  157. rx=rx*Cos(a)
  158. ry=ry*Sin(a)
  159. r=v*Sqrt(rx*rx+ry*ry)
  160. RETURN r
  161. getshort: PROCEDURE 
  162. ARG ptr,offset
  163. a=GETVALUE(D2C(ptr),offset,2,"N")
  164. IF a>32767 THEN a=a-65536
  165. RETURN a
  166. getpubname: 
  167. IF fwpub THEN
  168. pubname=fwpubscr
  169. ELSE
  170. DO
  171. pubname=""
  172. pubnptr=MAKEPOINTER(0,0,MAXPUBSCREENNAME,MEMF_CLEAR)
  173. IF pubnptr~=Null() THEN
  174. DO
  175. dummy=GetDefaultPubScreen(pubnptr)
  176. pubname=Import(pubnptr)
  177. CALL FREETHIS(pubnptr)
  178. END
  179. IF pubname="" THEN pubname="Workbench"
  180. IF pubname="Workbench" THEN CALL WBenchToFront()
  181. END
  182. RETURN pubname
  183. xexists: PROCEDURE 
  184. PARSE ARG file
  185. IF Pos(":",file)>0 THEN
  186. IF Pos(Upper(Left(file,Pos(":",file))),Upper(ShowList("A",,":")||ShowList("V",,":"))||":")>0 THEN
  187. ok=Exists(file)
  188. ELSE
  189. ok=0
  190. ELSE
  191. ok=Exists(file)
  192. RETURN ok
  193. newchkitem: 
  194. mchks=mchks+1
  195. chk=mchks+agads+tgads+wgads+sgads
  196. PARSE ARG ltxt.chk,mkey.chk,defchk.chk,mnode.chk
  197. RETURN chk
  198. newitem: 
  199. macts=macts+1
  200. nr=macts+mchks+agads+tgads+wgads+sgads
  201. PARSE ARG ltxt.nr,mkey.nr,mnode.nr
  202. RETURN nr
  203. newgadget: 
  204. agads=agads+1
  205. PARSE ARG labs.agads,lkey.agads,defchk.agads,defval.agads,defcyc.agads,gnode.agads,lbound.agads,ubound.agads
  206. RETURN agads
  207. newstr: 
  208. sgads=sgads+1
  209. gad=sgads+agads
  210. PARSE ARG len.gad,lkey.gad,line.gad,val.gad,gtype.gad,gnode.gad
  211. check.gad=0
  212. cycle.gad=0
  213. labs.gad=1
  214. slines=Max(slines,line.gad)
  215. RETURN gad
  216. newbutton: 
  217. tgads=tgads+1
  218. gad=tgads+agads+sgads
  219. PARSE ARG ltxt.gad,lkey.gad,lkey2.gad,gnode.gad
  220. RETURN gad
  221. newkey: 
  222. wgads=wgads+1
  223. gad=agads+tgads+wgads+sgads
  224. PARSE ARG lkey.gad,gnode.gad
  225. RETURN gad
  226. checksyntax: 
  227. PARSE ARG par.1,par.2,par.3
  228. ok=1
  229. DO i=1 TO 3 WHILE par.i~=""
  230. IF par.i=Upper(par.i) THEN INTERPRET "ar.i="||ar.i 
  231. ok=ok & Datatype(ar.i,par.i)
  232. END
  233. RETURN ok
  234. message: 
  235. PARSE ARG xiterr,msgtxt,buttxt,titletxt
  236. IF msgtxt="" THEN RETURN 0
  237. IF buttxt="" THEN buttxt=stdbut
  238. IF titletxt="" THEN titletxt=wintitle
  239. IF lib.reqtools THEN
  240. DO
  241. resume="BACKMSG"
  242. errtrap=14
  243. button=RTEZRequest(replacepat(msgtxt,"|","0A"x),buttxt,titletxt)
  244. END
  245. BACKMSG:
  246. IF trapped THEN 
  247. DO
  248. trapped=0
  249. lib.reqtools=0
  250. END
  251. IF ~lib.reqtools THEN
  252. IF lib.apig & cleangui & win~="00000000"x THEN
  253. button=EasyRequest(win,titletxt,replacepat(msgtxt,"|","0A"x),buttxt,Null(),0,0)
  254. ELSE
  255. SAY replacepat(msgtxt,"|","0A"x)
  256. IF xiterr>0 THEN CALL bye(xiterr)
  257. RETURN button
  258. init: 
  259. init=1
  260. bugreport="ENVARC:FinalWrapper/FWbugreport.rexx"
  261. errtext="@t (#@n)|in line @l"
  262. errormsg=""
  263. stdbut="OK"
  264. wintitle=""
  265. lockcnt=0
  266. errtrap=0
  267. getscrn=0
  268. objs=0
  269. sobjs=0
  270. deci=""
  271. et=""
  272. cleangui=0
  273. stilltoreply=0
  274. replymsg="00000000"x
  275. apig=1
  276. lib.apig=0
  277. reqtools=4
  278. lib.reqtools=0
  279. win="00000000"x
  280. defprfs=""
  281. defspecs=""
  282. defcolour=""
  283. deffont=""
  284. portname="FinalWrapperPort"
  285. IF Show("P",portname) THEN
  286. DO
  287. ADDRESS VALUE portname
  288. IF cliarg~="" THEN
  289. INTERPRET cliarg
  290. ELSE
  291. PopFront
  292. CALL bye(0)
  293. END
  294. fwkey="ENVARC:FinalWrapper/FWKeyfile"
  295. libs=5
  296. DO i=1 TO libs
  297. lib.i=0
  298. END
  299. library.apig="apig.library"
  300. library.2="rexxmathlib.library"
  301. library.3="rexxsupport.library"
  302. library.reqtools="rexxreqtools.library"
  303. guidelib=5
  304. library.guidelib="amigaguide.library"
  305. DO libn=1 TO libs
  306. lib.libn=Show("l",library.libn)
  307. IF ~lib.libn THEN lib.libn=AddLib(library.libn,0,-30,0)
  308. IF ~lib.libn & libn~=guidelib & libn~=reqtools THEN RETURN 14
  309. END
  310. help=lib.guidelib
  311. defdir=""
  312. temp=""
  313. preff.1=""
  314. preff.2=""
  315. wb3=1
  316. IF xexists("ENV:Workbench") THEN
  317. IF Open(prefs,"ENV:Workbench","R") THEN
  318. DO
  319. wb3=(ReadLn(prefs)>=39)
  320. CALL Close(prefs)
  321. END
  322. IF xexists("ENV:FinalWrapper") THEN
  323. DO
  324. preff.1="ENV:FinalWrapper/FinalWrapper.def"
  325. temp="ENV:FinalWrapper/FinalWrapper.temp"
  326. foreigntexts="ENV:FinalWrapper/FinalWrapper."
  327. IF Open(prefs,"ENV:FinalWrapper/FWPath","R") THEN
  328. DO
  329. defdir=ReadLn(prefs)
  330. CALL Close(prefs)
  331. END
  332. END
  333. IF xexists("ENVARC:FinalWrapper") THEN
  334. DO
  335. preff.2="ENVARC:FinalWrapper/FinalWrapper.def"
  336. foreigntexts="ENVARC:FinalWrapper/FinalWrapper."
  337. END
  338. finalw="FINALW."
  339. fwpubscr="FinalWriterPubScreen"
  340. libn=libs
  341. port=0
  342. oldlen=0
  343. oldtxt=0
  344. oldoval=0
  345. oldobjs=0
  346. oldpara=-1
  347. oldppos=-1
  348. oldplen=-1
  349. txt=0
  350. oval=0
  351. rx=0
  352. ry=0
  353. ovalx=""
  354. ovaly=""
  355. ovalw=""
  356. ovalh=""
  357. ovalp=""
  358. text=""
  359. mchks=0
  360. macts=0
  361. agads=0
  362. sgads=0
  363. tgads=0
  364. wgads=0
  365. slines=0
  366. ovalscanned=0
  367. gadgettext=0
  368. virtualtext=1
  369. alen=0
  370. txtrot=0
  371. windowpos=0
  372. prefsstore=1
  373. trapped=0
  374. specs.0=""
  375. font.0=""
  376. colour.0=""
  377. dirtysize=1
  378. newtbprefs=1
  379. sheetused=0
  380. dirtytext=1
  381. obl="00011111122222233333444445555666677778888999AA"
  382. obrot="0006121722273135394245"
  383. ftabsize=0
  384. defaultfont="FONT SoftSans"
  385. RETURN 0
  386. locale: 
  387. return=13 ; esc=27 ; bs=8 ; del=127
  388. IF xexists("ENV:") THEN
  389. ok=Open(prefs,"ENV:Language","R")
  390. ELSE
  391. ok=0
  392. IF ok THEN
  393. DO
  394. language=ReadLn(prefs)
  395. CALL Close(prefs)
  396. END
  397. ELSE
  398. language="english"
  399. ok=1
  400. IF xexists(foreigntexts||language) THEN
  401. IF Open(prefs,foreigntexts||language,"R") THEN
  402. DO
  403. DO UNTIL Eof(prefs)
  404. INTERPRET ReadLn(prefs)
  405. END
  406. CALL Close(prefs)
  407. ok=0
  408. END
  409. IF ok THEN 
  410. DO
  411. measure.1="?"
  412. measure.2="Inch"
  413. measure.3="cm"
  414. measure.4="Pica"
  415. docname="FinalWrapperSmall.Guide"
  416. origwintitle="@i - @f"
  417. origscrtitle="@i - @f"
  418. unnamed="Unnamed"
  419. defwinx=0
  420. defwiny=0
  421. aborttitle="<- Abort"
  422. busytitle="@i - Busy working, please wait..."
  423. gnode.0="REQUESTER"
  424. mnode.0="MENU"
  425. stdbut="OK"
  426. errtext="FinalWrapper failed:|@t|in line @l:|<@s>|(errornumber @n)"
  427. noselect="FinalWrapper failed:|First select an object and|a text block or some text|or enter the values in the|appropriate gadgets!"
  428. nolib="FinalWrapper failed:|Couldn't open '@y'"
  429. nofw="Run Final Writer first!"
  430. wrongos="FinalWrapper failed:|At least OS2.0 is required!"
  431. nogui="FinalWrapper failed:|Couldn't open requester!"
  432. notnum="@g|Value must be numeric!"
  433. noreqtools="Couldn't open rexxreqtools.library!"
  434. nohelp="On-line help not available!"
  435. rxcmderr="Unknown Arexx command|or syntax error:|@c"
  436. rxfilerq="Execute Arexx macro:"
  437. rxfileok="OK"
  438. about="FinalWrapper @v (@d)||@r||For suggestions & bugs write to:|    Andreas Weiss|    Dorfstrasse 24|    CH-8212 Nohl|    (Switzerland)||(E-mail: ndys@ezinfo.vmsmail.ethz.ch)||This program is SHAREWARE!|The share is sfr/DM 20 or $15"
  439. arc=newgadget(2,"u",0,360,0,"ARC",0,9999)
  440. ltxt.arc.1="Use arc °: Clockwise"
  441. ltxt.arc.2="Use arc °: Anticlockwise"
  442. beg=newgadget(3,"b",0,0,0,"BEGIN",0,359)
  443. ltxt.beg.1="Begin °: Absolute"
  444. ltxt.beg.2="Begin °: Clockwise"
  445. ltxt.beg.3="Begin °: Anticlockwise"
  446. rot=newgadget(4,"r",0,0,0,"ROTATE",0,359)
  447. ltxt.rot.1="Rotate °: Absolute"
  448. ltxt.rot.2="Rotate °: Clockwise"
  449. ltxt.rot.3="Rotate °: Anticlockwise"
  450. ltxt.rot.4="Rotate  : Title mode"
  451. wrd=newgadget(-4,"j",0,0,0,"WORDMODE")
  452. ltxt.wrd.1="Join words: No"
  453. ltxt.wrd.2="Join words: Centered"
  454. ltxt.wrd.3="Join words: Align left"
  455. ltxt.wrd.4="Join words: Align right"
  456. adj=newgadget(-5,"a",0,0,0,"ADJUST")
  457. ltxt.adj.1="Adjust: Nothing"
  458. ltxt.adj.2="Adjust: Character size"
  459. ltxt.adj.3="Adjust: Character width"
  460. ltxt.adj.4="Adjust: Apparent width"
  461. ltxt.adj.5="Adjust: Arc"
  462. adjarc=5
  463. spl=newgadget(2,"s",0,25,0,"SPIRAL",1,100)
  464. ltxt.spl.1="Spiral %: Outside > inside"
  465. ltxt.spl.2="Spiral %: Inside > outside"
  466. siz=newgadget(2,"f",0,100,0,"SIZE",1,100)
  467. ltxt.siz.1="Font size %: Decreasing"
  468. ltxt.siz.2="Font size %: Increasing"
  469. zoo=newgadget(3,"z",0,50,0,"ZOOM",1,1000)
  470. ltxt.zoo.1="Zoom %: All"
  471. ltxt.zoo.2="Zoom %: Height"
  472. ltxt.zoo.3="Zoom %: Width"
  473. ink=newgadget(-5,"c",0,0,0,"COLOUR")
  474. ltxt.ink.1="Colour: From text"
  475. ltxt.ink.2="Colour: From oval fill"
  476. ltxt.ink.3="Colour: From oval border"
  477. ltxt.ink.4="Colour: Shadow = oval fill"
  478. ltxt.ink.5="Colour: Shadow = oval border"
  479. pat=newgadget(0,"p",0,0,0,"PATTERN")
  480. ltxt.pat="Pattern from selected text"
  481. xgad=newstr(7,"x",1,"",1,"XPOS")
  482. ltxt.xgad="(@m) X:"
  483. ygad=newstr(7,"y",1,"",1,"YPOS")
  484. ltxt.ygad="Y:"
  485. wgad=newstr(7,"w",1,"",1,"WIDTH")
  486. ltxt.wgad="Width:"
  487. hgad=newstr(7,"h",1,"",1,"HEIGHT")
  488. ltxt.hgad="Height:"
  489. pgad=newstr(4,"#",1,1,0,"PAGE")
  490. ltxt.pgad="# of page:"
  491. tgad=newstr(200,"t",2,"",2,"TEXT")
  492. ltxt.tgad="Text:"
  493. okgad=newbutton("  OK  ","o",RETURN,"OK")
  494. cancelgad=newbutton("Quit","q",esc,"CANCEL")
  495. closegad=newkey(del,"CLOSE")
  496. zipgad=newkey(" ","ZIP")
  497. depthgad=newkey(bs,"BACK")
  498. mtitle="Settings"
  499. mgad=newchkitem("Gadgets are auto-activated","G",1,"ACTIVATE")
  500. mspl=newchkitem("Adjust arc for spirals","A",1,"IMPROVE")
  501. mrel=newchkitem("Final Writer Release 3","F",0,"RELEASE")
  502. CALL newitem("","",mnode.0)
  503. mload=newitem("Load","L","LOAD")
  504. msave=newitem("Save","S","SAVE")
  505. mres=newitem("Reset","R","RESET")
  506. mdef=newitem("Defaults","D","DEFAULTS")
  507. CALL newitem("","",mnode.0)
  508. mtext=newitem("Text block preferences","T","TEXTPREFS")
  509. moval=newitem("Oval preferences","O","OVALPREFS")
  510. CALL newitem("","",mnode.0)
  511. mnext=newitem("Next Document","N","NEXT")
  512. mrexx=newitem("Execute Arexx macro...","E","MACRO")
  513. mhelp=newitem("Help...","H","HELP")
  514. mabt=newitem("About...","?","ABOUT")
  515. fwerrtext.5="Instruction didn't succeed"
  516. fwerrtext.10="Instruction failed"
  517. fwerrtext.20="Invalid arguments"
  518. fwerrtext.100="Unknown instruction"
  519. fwerrtext.200="Couldn't open fwarexx.library"
  520. END
  521. RETURN
  522. checkenv: 
  523. about=replacepat(replacepat(replacepat(about,"@v",version),"@d",date),"@r",copyright)
  524. info=replacepat(replacepat("FinalWrapper @v by NDY's","@v",version),"@d",date)
  525. origwintitle=replacepat(origwintitle,"@i",info)
  526. origscrtitle=replacepat(origscrtitle,"@i",info)
  527. wtitle=origwintitle
  528. stitle=origscrtitle
  529. busytitle=replacepat(busytitle,"@i",info)
  530. doc=""
  531. CALL newdoc
  532. menus=mchks+macts
  533. gads=agads+tgads+sgads
  534. kgads=gads+wgads
  535. menuoff=kgads
  536. i=32+menuoff
  537. mnode.i=mnode.0
  538. prefsize=agads*4+mchks+4
  539. prefsid="FW30"||D2C(prefsize,2)
  540. tempsize=0
  541. IF temp~="" THEN
  542. DO id=agads+1 TO agads+sgads
  543. tempsize=tempsize+len.id
  544. END
  545. cancelclose=cancelgad-agads
  546. okclose=okgad-agads
  547. winclose=tgads+1
  548. rxclose=winclose+1
  549. nextclose=rxclose+1
  550. DO id=1 TO kgads
  551. IF ~Datatype(lkey.id,"W") THEN lkey.id=C2D(Upper(lkey.id))
  552. END
  553. IF initerr=14 THEN
  554. DO
  555. ln=replacepat(nolib,"@y",library.libn)
  556. CALL message(14,ln)
  557. CALL bye(14)
  558. END
  559. execbase=GETVALUE("4"x,0,4,"P")
  560. osversion=GETVALUE(execbase,20,2,"N")
  561. IF osversion<37 THEN CALL message(10,wrongos)
  562. IF ~xexists(fwkey) THEN fwkey=""
  563. IF help THEN
  564. DO
  565. docfile="HELP:"||language||"/"||docname
  566. IF ~xexists(docfile) THEN
  567. DO
  568. docfile="ENVARC:FinalWrapper/"||docname
  569. IF ~xexists(docfile) THEN help=0
  570. END
  571. END
  572. RETURN
  573. guiinit: 
  574. IF cleangui THEN RETURN 0
  575. pubscr=Null() ; scr=Null() ; win=Null() ; gad=Null() ; scrvinfo=Null() ; menu=Null() ; port=0 ; menustrip=0
  576. cleangui=1
  577. CALL SET_APIG_GLOBALS()
  578. GT_TAGBASE=X2D("80080000")
  579. GTMN_NEWLOOKMENUS=X2C("80080043")
  580. GTCB_SCALED=X2C("80080044")
  581. WA_NEWLOOKMENUS=X2C("80000093")
  582. nullbyte=D2C(0)
  583. port=OpenPort(portname)
  584. IF ~port THEN RETURN 5
  585. pubscr=LockPubScreen(fwpubscr)
  586. fwpub=(pubscr~=Null())
  587. IF ~fwpub & portok & fwkey~="" THEN
  588. DO
  589. SIGNAL OFF ERROR
  590. ADDRESS COMMAND ''fwkey''
  591. SIGNAL ON ERROR
  592. customscr=D2C(RC,4)
  593. END
  594. ELSE
  595. customscr=Null()
  596. IF fwpub THEN
  597. scr=pubscr
  598. ELSE
  599. IF customscr=Null() THEN
  600. DO
  601. pubscr=LockPubScreen("")
  602. IF pubscr=Null() THEN RETURN 5
  603. scr=pubscr
  604. END
  605. ELSE
  606. scr=customscr
  607. scrvinfo=GetVisualInfo(scr)
  608. IF scrvinfo=Null() THEN RETURN 5
  609. scrfont=GETVALUE(scr,40,4,"P")
  610. fonth=GETVALUE(scrfont,4,2,"N")
  611. scrrp=D2C(C2D(scr)+84)
  612. glistptr=MAKEPOINTER(0,0,4,MEMF_CLEAR)
  613. IF glistptr=Null() THEN RETURN 5
  614. borderl=GETVALUE(scr,36,1,"N")
  615. borderr=GETVALUE(scr,37,1,"N")
  616. bordert=GETVALUE(scr,35,1,"N")+fonth+1
  617. rows=2
  618. gadh=fonth+4
  619. gaddy=gadh+2
  620. DO i=1 TO 3+slines
  621. maxwidth.i=0
  622. END
  623. charw=TextLength(scrrp,"W"||nullbyte,-1) 
  624. intw=charw*4+12   
  625. strminw=charw*2+6
  626. addwidth=30+intw
  627. gperrow=agads%rows+agads//rows
  628. DO id=1 TO agads
  629. k=1+(id>gperrow)
  630. IF labs.id=0 THEN
  631. DO
  632. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+34
  633. maxwidth.k=Max(maxwidth.k,gwid.id)
  634. END
  635. ELSE
  636. DO
  637. glabels.id=MAKEPOINTER(0,0,4*Abs(labs.id)+4,MEMF_CLEAR)
  638. IF glabels.id=Null() THEN RETURN 5
  639. DO i=1 TO Abs(labs.id) 
  640. lbuf.id.i=MAKEPOINTER(glabels.id,0,Length(ltxt.id.i)+1,MEMF_CLEAR)
  641. IF lbuf.id.i=Null() THEN RETURN 5
  642. CALL Export(lbuf.id.i,ltxt.id.i)
  643. CALL SETVALUE(glabels.id,(i-1)*4,4,"P",lbuf.id.i)
  644. xwid=TextLength(scrrp,ltxt.id.i||nullbyte,-1)+30
  645. IF labs.id>0 THEN xwid=xwid+addwidth
  646. maxwidth.k=Max(maxwidth.k,xwid)
  647. END
  648. END
  649. END
  650. DO i=1 TO slines
  651. nsgads.i=0
  652. END
  653. DO id=agads+1 TO agads+sgads
  654. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)
  655. lin=line.id
  656. maxnr=3+lin
  657. maxwidth.maxnr=maxwidth.maxnr+gwid.id+strminw+12
  658. nsgads.lin=nsgads.lin+1
  659. END
  660. DO id=agads+sgads+1 TO gads
  661. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+6
  662. maxwidth.3=maxwidth.3+gwid.id+2
  663. END
  664. maxwidth=Max((Max(maxwidth.1,maxwidth.2)+4)*rows-4,maxwidth.3)
  665. DO i=4 TO slines+3
  666. maxwidth=Max(maxwidth,maxwidth.i)
  667. END
  668. winwid=maxwidth+4
  669. winhi=(gperrow+1+slines)*gaddy+6
  670. gadx=borderl+2
  671. gady=bordert+1
  672. gadw=maxwidth%rows-rows*2+2
  673. gadmaxx=winwid+borderl-2
  674. gadmaxy=winhi+bordert-1
  675. id=0
  676. gx=gadx
  677. cyx=gx
  678. chkx=gx+gadw-26
  679. intx=gx+gadw-28-intw
  680. textplace=PLACETEXT_LEFT
  681. DO i=0 TO 1
  682. DO j=0 TO gperrow-1 WHILE id<agads
  683. id=i*gperrow+j+1
  684. gadid=id*3
  685. IF labs.id>0 THEN
  686. DO
  687. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gady+j*gaddy,gadw-addwidth,gadh,"",0,gadid,Null())
  688. newgadxb.id=MAKENEWGADGET(scrvinfo,scrfont,chkx,gady+j*gaddy,26,gadh,"",0,gadid+1,Null())
  689. newgadxi.id=MAKENEWGADGET(scrvinfo,scrfont,intx,gady+j*gaddy,intw,gadh,"",0,gadid+2,Null())
  690. IF newgadxb.id=Null() | newgadxi.id=Null() | newgadx.id=Null() THEN RETURN 5
  691. END
  692. ELSE
  693. DO
  694. IF labs.id<0 THEN
  695. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,cyx,gady+j*gaddy,gadw,gadh,"",0,id*3,Null())
  696. ELSE
  697. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,chkx,gady+j*gaddy,26,gadh,ltxt.id,textplace,id*3+1,Null())
  698. IF newgadx.id=Null() THEN RETURN 5
  699. END
  700. END
  701. chkx=gadmaxx-gadw
  702. intx=chkx+28
  703. gx=chkx+addwidth
  704. cyx=chkx
  705. textplace=PLACETEXT_RIGHT
  706. END
  707. gy=gady+gaddy*gperrow
  708. DO i=1 TO slines
  709. gx=gadx
  710. maxnr=i+3
  711. strw=(maxwidth-maxwidth.maxnr)%(nsgads.i)+strminw
  712. DO id=agads+1 TO agads+sgads
  713. IF line.id=i THEN
  714. DO
  715. nsgads.i=nsgads.i-1
  716. IF nsgads.i=0 THEN strw=gadmaxx-(gx+gwid.id+8)
  717. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx+gwid.id+8,gy,strw,gadh,ltxt.id,PLACETEXT_LEFT,id*3+2,Null())
  718. gx=gx+gwid.id+strw+12
  719. IF newgadx.id=Null() THEN RETURN 5
  720. END
  721. END
  722. gy=gy+gaddy
  723. END
  724. gx=gadx+(maxwidth-maxwidth.3)%2
  725. DO id=agads+sgads+1 TO gads
  726. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gadmaxy-gadh,gwid.id,gadh,ltxt.id,PLACETEXT_IN,id*3,Null())
  727. gx=gx+gwid.id+4
  728. IF newgadx.id=Null() THEN RETURN 5
  729. END
  730. newgadbv=MAKENEWGADGET(scrvinfo,scrfont,gadx,gadmaxy-gadh-5,maxwidth,2,0,0,Null())
  731. gad=CreateContext(glistptr)
  732. prev=gad
  733. DO id=1 TO gads
  734. IF id>agads THEN
  735. IF id>agads+sgads THEN
  736. DO
  737. checkgad.id=CreateGadget(BUTTON_KIND,prev,newgadx.id,TAG_DONE,0)
  738. prev=checkgad.id
  739. END
  740. ELSE
  741. DO
  742. IF gtype.id=0 THEN
  743. intgad.id=CreateGadget(INTEGER_KIND,prev,newgadx.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,len.id,STRINGA_EXITHELP,1,TAG_DONE,0)
  744. ELSE
  745. intgad.id=CreateGadget(STRING_KIND,prev,newgadx.id,GTST_STRING,val.id,GTST_MAXCHARS,len.id,STRINGA_EXITHELP,1,TAG_DONE,0)
  746. prev=intgad.id
  747. END
  748. ELSE
  749. IF labs.id=0 THEN
  750. DO
  751. checkgad.id=CreateGadget(CHECKBOX_KIND,prev,newgadx.id,GTCB_CHECKED,check.id,GTCB_SCALED,-1,TAG_DONE,0)
  752. prev=checkgad.id
  753. END
  754. ELSE
  755. IF labs.id>0 THEN
  756. DO
  757. checkgad.id=CreateGadget(CHECKBOX_KIND,prev,newgadxb.id,GTCB_CHECKED,check.id,GTCB_SCALED,-1,TAG_DONE,0)
  758. intgad.id=CreateGadget(INTEGER_KIND,checkgad.id,newgadxi.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,4,STRINGA_EXITHELP,1,TAG_DONE,0)
  759. cyclegad.id=CreateGadget(CYCLE_KIND,intgad.id,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  760. prev=cyclegad.id
  761. END
  762. ELSE
  763. DO
  764. cyclegad.id=CreateGadget(CYCLE_KIND,prev,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  765. prev=cyclegad.id
  766. END
  767. END
  768. prev=CreateGadget(TEXT_KIND,prev,newgadbv,GTTX_BORDER,-1,TAG_DONE,0)
  769. IF prev=Null() THEN RETURN 5 
  770. mptr=MAKENEWMENU(menus)
  771. IF mptr=Null() THEN RETURN 5
  772. CALL ADDTO_NEWMENU(mptr,NM_TITLE,mtitle,"",0,0,Null())
  773. DO i=1 TO menus
  774. n=menuoff+i
  775. IF ltxt.n="" THEN
  776. mtxt=NM_BARLABEL
  777. ELSE
  778. mtxt=ltxt.n
  779. IF i>mchks THEN
  780. flags=MENUTOGGLE
  781. ELSE
  782. flags=CHECKED*check.n+CHECKIT+MENUTOGGLE
  783. IF Length(mkey.n)~=1 THEN mkey.n=""
  784. CALL ADDTO_NEWMENU(mptr,NM_ITEM,mtxt,mkey.n,flags,0,Null())
  785. END
  786. DROP ltxt
  787. CALL ADDTO_NEWMENU(mptr,NM_END,"","",0,0,Null())
  788. menu=CreateMenus(mptr,TAG_DONE,0)
  789. IF menu=Null() THEN RETURN 5
  790. IF LayoutMenus(menu,scrvinfo,GTMN_NEWLOOKMENUS,-1,TAG_DONE,0)=0 THEN RETURN 5
  791. winidcmp=IDCMP_CHANGEWINDOW+IDCMP_CLOSEWINDOW+IDCMP_GADGETUP+IDCMP_ACTIVEWINDOW+IDCMP_MOUSEBUTTONS+IDCMP_MENUPICK+IDCMP_VANILLAKEY+IDCMP_RAWKEY+IDCMP_MENUHELP
  792. winflags=WFLG_CLOSEGADGET+WFLG_DEPTHGADGET+WFLG_DRAGBAR+WFLG_ACTIVATE
  793. wtagl=MAKEPOINTER(0,0,104+8,MEMF_CLEAR)
  794. IF wtagl=Null() THEN RETURN 5
  795. wname=MAKEPOINTER(wtagl,0,Length(wintitle)+1,MEMF_CLEAR)
  796. IF wname=Null() THEN RETURN 5
  797. CALL Export(wname,wintitle)
  798. sname=MAKEPOINTER(wtagl,0,Length(scrtitle)+1,MEMF_CLEAR)
  799. IF sname=Null() THEN RETURN 5
  800. CALL Export(sname,scrtitle)
  801. wzipdims=MAKEPOINTER(wtagl,0,8,MEMF_CLEAR)
  802. IF wzipdims=Null() THEN RETURN 5
  803. zipwid=winwid+borderl+borderr
  804. ziphi=bordert
  805. CALL SETVALUE(wzipdims,4,2,"N",zipwid)
  806. CALL SETVALUE(wzipdims,6,2,"N",ziphi)
  807. CALL SETTAGSLOT(wtagl,0,WA_LEFT,"N",winx)
  808. CALL SETTAGSLOT(wtagl,1,WA_TOP,"N",winy)
  809. CALL SETTAGSLOT(wtagl,2,WA_INNERWIDTH,"N",winwid)
  810. CALL SETTAGSLOT(wtagl,3,WA_INNERHEIGHT,"N",winhi)
  811. CALL SETTAGSLOT(wtagl,4,WA_IDCMP,"N",winidcmp)
  812. CALL SETTAGSLOT(wtagl,5,WA_FLAGS,"N",winflags)
  813. CALL SETTAGSLOT(wtagl,6,WA_TITLE,"P",wname)
  814. CALL SETTAGSLOT(wtagl,7,WA_SCREENTITLE,"P",sname)
  815. CALL SETTAGSLOT(wtagl,8,WA_GADGETS,"P",gad)
  816. IF scr=pubscr THEN
  817. CALL SETTAGSLOT(wtagl,9,WA_PUBSCREEN,"P",scr)
  818. ELSE
  819. CALL SETTAGSLOT(wtagl,9,WA_CUSTOMSCREEN,"P",scr)
  820. CALL SETTAGSLOT(wtagl,10,WA_ZOOM,"P",wzipdims)
  821. CALL SETTAGSLOT(wtagl,11,WA_NEWLOOKMENUS,"N",-1)
  822. CALL SETTAGSLOT(wtagl,12,WA_MENUHELP,"N",-1)
  823. CALL SETTAGSLOT(wtagl,13,TAG_DONE,"N",0)
  824. win=OpenWindowTagList(portname,Null(),wtagl,0)
  825. IF pubscr~=Null() THEN
  826. DO
  827. CALL UnLockPubScreen(Null(),pubscr)
  828. pubscr=Null()
  829. END
  830. IF win=Null() THEN RETURN 5
  831. rp=GETWINDOWRASTPORT(win)
  832. dwid=GETVALUE(win,8,2,"N")-zipwid
  833. dhi=GETVALUE(win,10,2,"N")-ziphi
  834. CALL GT_RefreshWindow(win,Null())
  835. CALL SetMenuStrip(win,menu)
  836. menustrip=1
  837. zoomed=1
  838. RETURN 0
  839. messy: 
  840. IF port=0 THEN RETURN
  841. DO FOREVER
  842. msg=GetPkt(portname)
  843. IF msg=Null() THEN LEAVE
  844. msgclass=GetArg(msg,0)
  845. zipped=GETVALUE(win,10,2,"N")=ziphi
  846. IF ~Datatype(msgclass,"W") THEN
  847. CALL rx
  848. ELSE
  849. DO
  850. code=GetArg(msg,1)
  851. qual=GetArg(msg,2)
  852. gadid=GetArg(msg,9)
  853. CALL Reply(msg,0)
  854. END
  855. actgads=check.mgad & ~zipped
  856. nospiral=~check.spl
  857. IF msgclass=IDCMP_VANILLAKEY THEN
  858. DO
  859. code=C2D(Upper(D2C(code)))
  860. DO id=1 TO kgads
  861. IF code=lkey.id | code=lkey2.id THEN
  862. DO
  863. IF id=zipgad THEN
  864. DO
  865. CALL ZipWindow(win)
  866. LEAVE
  867. END
  868. ELSE
  869. IF id=depthgad THEN
  870. DO
  871. windowpos=~windowpos
  872. IF windowpos THEN
  873. CALL WindowToBack(win)
  874. ELSE
  875. CALL WindowToFront(win)
  876. LEAVE
  877. END
  878. ELSE
  879. IF id>agads+sgads THEN
  880. DO
  881. closed=id-agads
  882. LEAVE
  883. END
  884. IF ~zipped THEN
  885. DO
  886. msgclass=IDCMP_GADGETUP
  887. type=(qual//4)//3
  888. IF labs.id=0 THEN type=1
  889. IF labs.id<0 THEN type=0
  890. IF id>agads THEN type=2
  891. gadid=id*3+type
  892. IF type=2 | (actgads & ~(check.id & type=1)) THEN CALL ActivateGadget(intgad.id,win,Null())
  893. IF type=1 THEN code=~check.id
  894. IF labs.id>=0 & type=1 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,code)
  895. IF type=0 THEN code=(cycle.id+1)//Abs(labs.id)
  896. IF labs.id~=0 & type=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  897. LEAVE
  898. END
  899. END
  900. END
  901. END
  902. SELECT
  903. WHEN msgclass=IDCMP_CLOSEWINDOW THEN closed=winclose
  904. WHEN msgclass=IDCMP_MENUPICK THEN
  905. DO
  906. mnr=(code%32)//32+1
  907. n=menuoff+mnr
  908. IF mnr<=mchks THEN check.n=~check.n
  909. SELECT
  910. WHEN n=mload THEN
  911. CALL loaddef(2)
  912. WHEN n=msave THEN
  913. CALL savedef(2)
  914. WHEN n=mres THEN
  915. CALL loaddef(1)
  916. WHEN n=mdef THEN
  917. CALL loaddef(0)
  918. WHEN n=mabt THEN
  919. CALL message(0,about)
  920. WHEN n=mtext THEN
  921. IF portok THEN
  922. DO
  923. resume="BACKMESSY"
  924. errtrap=10
  925. SelectObject
  926. TextBlockPrefs "PROMPT"
  927. newtbprefs=1
  928. GetTextBlockPrefs "TEXT"
  929. x=RESULT
  930. IF x~="" THEN
  931. DO
  932. val.tgad=x
  933. CALL updategadgets
  934. END
  935. END
  936. WHEN n=moval THEN
  937. IF portok THEN
  938. DO
  939. resume="BACKMESSY"
  940. errtrap=10
  941. SelectObject
  942. OvalPrefs "PROMPT"
  943. END
  944. WHEN n=mnext THEN
  945. DO
  946. x=SubStr(rxport,Length(finalw)+1)
  947. i=x
  948. DO UNTIL Show("P",rxport) | i=x
  949. i=i//20+1
  950. rxport=finalw||i
  951. END
  952. IF x~=i THEN closed=nextclose
  953. END
  954. WHEN n=mrexx THEN
  955. IF lib.reqtools THEN
  956. DO
  957. i=Max(Pos(defdir,':'),LastPos('/',defdir))
  958. resume="BACKMESSY"
  959. errtrap=14
  960. newdir=RTFileRequest(SubStr(defdir,1,i),DelStr(defdir,1,i),rxfilerq,rxfileok,"RT_SCREENTOFRONT=TRUE")
  961. IF newdir~="" THEN
  962. DO
  963. defdir=newdir
  964. IF xexists("ENV:FinalWrapper") THEN 
  965. IF Open(prefs,"ENV:FinalWrapper/FWPath","W") THEN
  966. DO
  967. CALL WriteLn(prefs,defdir)
  968. CALL Close(prefs)
  969. END
  970. closed=rxclose
  971. END
  972. END
  973. WHEN n=mhelp THEN
  974. IF help THEN
  975. DO
  976. IF wb3 THEN
  977. CALL Shownode(getpubname(),docfile,"MAIN",1,0)
  978. ELSE
  979. CALL Shownode(getpubname(),docfile,"MAIN",1)
  980. CALL ScreenToFront(scr)
  981. END
  982. ELSE
  983. CALL message(0,nohelp)
  984. OTHERWISE NOP
  985. END
  986. END
  987. WHEN actgads & (msgclass=IDCMP_ACTIVEWINDOW | msgclass=IDCMP_MOUSEBUTTONS) THEN CALL ActivateGadget(intgad.1,win,Null())
  988. WHEN msgclass=IDCMP_MENUHELP | (code=95 & (msgclass=IDCMP_RAWKEY | msgclass=IDCMP_GADGETUP)) THEN
  989. IF help THEN
  990. DO
  991. mnr=(code%32)//32+1+menuoff
  992. IF msgclass=IDCMP_MENUHELP THEN
  993. node=mnode.mnr
  994. ELSE
  995. IF zipped THEN
  996. node=gnode.0
  997. ELSE 
  998. DO
  999. ymouse=getshort(C2D(win),12)
  1000. xmouse=getshort(C2D(win),14)
  1001. gad=GETVALUE(win,62,4,"P")
  1002. id=0
  1003. IF xmouse>=0 & ymouse>=0 & xmouse<dwid+zipwid & ymouse<dhi+ziphi & gad~=Null() THEN
  1004. DO UNTIL gad=Null()
  1005. x=getshort(C2D(gad),4)
  1006. y=getshort(C2D(gad),6)
  1007. w=getshort(C2D(gad),8)
  1008. h=getshort(C2D(gad),10)
  1009. i=GETVALUE(gad,38,2,"N")
  1010. IF xmouse>=x & xmouse<=x+w & ymouse>=y & ymouse<=y+h & i>0 THEN
  1011. DO
  1012. id=i%3
  1013. LEAVE
  1014. END
  1015. ELSE
  1016. gad=GETVALUE(gad,0,4,"P")
  1017. END
  1018. node=gnode.id
  1019. END
  1020. IF wb3 THEN
  1021. CALL Shownode(getpubname(),docfile,node,1,0)
  1022. ELSE
  1023. CALL Shownode(getpubname(),docfile,node,1)
  1024. CALL ScreenToFront(scr)
  1025. END
  1026. ELSE
  1027. CALL message(0,nohelp)
  1028. WHEN msgclass=IDCMP_GADGETUP THEN
  1029. DO
  1030. type=gadid//3
  1031. id=gadid%3
  1032. SELECT
  1033. WHEN id>agads+sgads THEN closed=id-agads 
  1034. WHEN type=2 THEN CALL checkstrgad 
  1035. WHEN type=1 THEN  
  1036. DO
  1037. check.id=code
  1038. IF labs.id>0 & check.id~=0 & actgads THEN CALL ActivateGadget(intgad.id,win,Null())
  1039. END
  1040. OTHERWISE 
  1041. DO
  1042. cycle.id=code
  1043. check.id=1
  1044. IF labs.id>0 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  1045. IF labs.id>0 & actgads THEN CALL ActivateGadget(intgad.id,win,Null())
  1046. END
  1047. END
  1048. END
  1049. OTHERWISE NOP
  1050. END
  1051. IF check.mspl THEN
  1052. IF check.spl & nospiral THEN 
  1053. DO
  1054. cycle.adj=adjarc-1
  1055. CALL GT_SetGadgetAttrs(cyclegad.adj,win,Null(),GTCY_ACTIVE,cycle.adj)
  1056. END
  1057. END
  1058. BACKMESSY:
  1059. IF trapped THEN
  1060. DO
  1061. trapped=0
  1062. IF err=14 THEN
  1063. DO
  1064. lib.reqtools=0
  1065. CALL message(0,noreqtools)
  1066. END
  1067. END
  1068. RETURN
  1069. checkstrgad: 
  1070. old=val.id
  1071. specialinfo=GETVALUE(intgad.id,34,4,"P")
  1072. IF id>agads THEN
  1073. DO
  1074. IF gtype.id=0 THEN
  1075. val.id=GETVALUE(specialinfo,28,4,"N")
  1076. ELSE
  1077. DO
  1078. gval=GETVALUE(specialinfo,0,4,"S")
  1079. IF gtype.id=1 & gval~=old THEN
  1080. DO
  1081. IF gval~="" THEN
  1082. IF ~Datatype(replacepat(gval,",","."),"N") THEN
  1083. DO
  1084. IF closed=okclose THEN closed=0
  1085. IF closed=0 THEN CALL message(0,replacepat(notnum,"@g",ltxt.id))
  1086. END
  1087. ELSE
  1088. IF deci="COMMA" THEN
  1089. val.id=replacepat(Max(replacepat(gval,",","."),0),".",",")
  1090. ELSE
  1091. val.id=Max(replacepat(gval,",","."),0)
  1092. ELSE
  1093. val.id=""
  1094. IF val.id~=gval THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,val.id)
  1095. END
  1096. ELSE
  1097. IF gtype.id=2 THEN val.id=gval
  1098. END
  1099. END
  1100. ELSE
  1101. DO
  1102. gval=GETVALUE(specialinfo,28,4,"N")
  1103. val.id=Max(Min(ubound.id,gval),lbound.id)
  1104. IF val.id~=gval THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  1105. check.id=check.id | (old~=val.id & actgads)
  1106. IF old~=val.id | actgads THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  1107. END
  1108. RETURN
  1109. rx: 
  1110. PARSE VAR msgclass comm ar.1 ar.2 ar.3
  1111. arg1=Upper(ar.1)
  1112. arg2=SubStr(msgclass,Pos(ar.1,msgclass,Length(comm)+1)+Length(ar.1)+1)
  1113. IF Datatype(arg1,"U") THEN INTERPRET "id="||arg1
  1114. comm=Upper(comm)
  1115. full=msgclass
  1116. msgclass=0
  1117. ret=0
  1118. res=0
  1119. SELECT
  1120. WHEN comm="SETVAL" THEN
  1121. IF checksyntax("W") & ar.2~="" THEN
  1122. SELECT
  1123. WHEN id>0 & id<=agads THEN
  1124. IF labs.id>0 & Datatype(ar.2,"W") THEN
  1125. DO
  1126. gadid=id*3+2
  1127. msgclass=IDCMP_GADGETUP
  1128. code=0
  1129. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,ar.2)
  1130. res=val.id
  1131. END
  1132. WHEN id>agads & id<=agads+sgads THEN
  1133. IF Datatype(replacepat(ar.2,",","."),Word("W N A",gtype.id+1)) | gtype.id=2 THEN
  1134. DO
  1135. gadid=id*3+2
  1136. msgclass=IDCMP_GADGETUP
  1137. code=0
  1138. IF gtype.id=2 THEN
  1139. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,arg2)
  1140. ELSE
  1141. IF gtype.id=1 THEN
  1142. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,ar.2)
  1143. ELSE
  1144. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,ar.2)
  1145. res=val.id
  1146. END
  1147. OTHERWISE NOP
  1148. END
  1149. WHEN comm="SETMODE" THEN
  1150. IF checksyntax("W","w") &  id>0 & id<=agads & labs.id~=0 THEN
  1151. DO
  1152. gadid=id*3
  1153. msgclass=IDCMP_GADGETUP
  1154. code=ar.2
  1155. CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  1156. res=cycle.id
  1157. END
  1158. WHEN comm="SETSTATE" THEN
  1159. IF checksyntax("W","w") THEN
  1160. IF id>0 & id<=agads THEN
  1161. IF labs.id>=0 THEN
  1162. DO
  1163. gadid=id*3+1
  1164. msgclass=IDCMP_GADGETUP
  1165. code=(ar.2~=0)
  1166. CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,code)
  1167. res=check.id
  1168. END
  1169. ELSE 
  1170. DO
  1171. gadid=id*3
  1172. msgclass=IDCMP_GADGETUP
  1173. code=(ar.2~=0)
  1174. CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  1175. res=(cycle.id~=0)
  1176. END
  1177. ELSE
  1178. IF id>menuoff & id<=menuoff+mchks THEN
  1179. DO
  1180. check.id=(ar.2~=0)
  1181. CALL ClearMenuStrip(win)
  1182. item=GETVALUE(menu,18,4,"P")
  1183. DO n=menuoff+1 TO id-1
  1184. item=GETVALUE(item,0,4,"P")
  1185. END
  1186. flags=C2D(B2C(BitAnd(C2B(D2C(GETVALUE(item,12,2,"N"),2)),"1111111011111111")))+CHECKED*check.id
  1187. CALL SETVALUE(item,12,2,"N",flags,0)
  1188. CALL ResetMenuStrip(win,menu)
  1189. msgclass=-1
  1190. END
  1191. WHEN comm="GETVAL" THEN
  1192. IF checksyntax("W") & id>0 & ((id<=agads & labs.id>0) | id<=agads+sgads) THEN
  1193. DO
  1194. specialinfo=GETVALUE(intgad.id,34,4,"P")
  1195. IF id>agads & gtype.id~=0 THEN
  1196. DO
  1197. val=GETVALUE(specialinfo,0,4,"S")
  1198. IF gtype.id=1 THEN val=replacepat(val,",",".")
  1199. END
  1200. ELSE
  1201. val=GETVALUE(specialinfo,28,4,"N")
  1202. res=val
  1203. msgclass=-1
  1204. END
  1205. WHEN comm="GETMODE" THEN
  1206. IF checksyntax("W") & id>0 & id<=agads THEN
  1207. DO
  1208. res=cycle.id
  1209. msgclass=-1
  1210. END
  1211. WHEN comm="GETSTATE" THEN
  1212. IF checksyntax("W") & ((id>0 & id<=agads) | (id>menuoff & id<=menuoff+mchks)) THEN
  1213. DO
  1214. IF id>0 & id<=agads & labs.id<0 THEN 
  1215. res=(cycle.id~=0)
  1216. ELSE
  1217. res=check.id
  1218. msgclass=-1
  1219. END
  1220. WHEN comm="USE" THEN
  1221. IF checksyntax("W") THEN
  1222. IF id>=agads+sgads & id<=kgads THEN
  1223. DO
  1224. msgclass=-1
  1225. IF id=zipgad THEN
  1226. CALL ZipWindow(win)
  1227. ELSE
  1228. IF id=depthgad THEN
  1229. DO
  1230. windowpos=~windowpos
  1231. IF windowpos THEN
  1232. CALL WindowToBack(win)
  1233. ELSE
  1234. CALL WindowToFront(win)
  1235. END
  1236. ELSE
  1237. DO
  1238. msgclass=IDCMP_GADGETUP
  1239. code=0
  1240. gadid=id*3
  1241. END
  1242. END
  1243. ELSE
  1244. IF id>menuoff+mchks & id<=menuoff+mchks+macts THEN
  1245. DO
  1246. msgclass=IDCMP_MENUPICK
  1247. code=(id-1-menuoff)*32
  1248. END
  1249. WHEN comm="SETSTYLE" THEN
  1250. IF ar.1>=0 & ar.1<=Length(text) THEN
  1251. DO
  1252. msgclass=-1
  1253. IF ar.1=0 THEN 
  1254. DO
  1255. j=1
  1256. k=Length(text)
  1257. END
  1258. ELSE
  1259. DO
  1260. j=ar.1
  1261. k=j
  1262. END
  1263. y=arg2
  1264. DO i=j TO k
  1265. tprfs=specs.i
  1266. tfontp=font.i
  1267. tcolourp=colour.i
  1268. arg2=y
  1269. DO WHILE arg2~=""
  1270. x=Upper(Word(arg2,1))
  1271. v=Word(arg2,2)
  1272. SELECT
  1273. WHEN Pos(x||"|","SIZE|WIDTH|OBLIQUE|")>0 THEN
  1274. DO
  1275. p=Pos(x,tprfs)
  1276. tprfs=Left(tprfs,p-1)||x v DelWord(SubStr(tprfs,p),1,2) 
  1277. END
  1278. WHEN x="COLOR" THEN
  1279. tcolourp=x v
  1280. WHEN x="FONT" THEN
  1281. tfontp=x v
  1282. WHEN Pos(x||"|","LEADING|POSITION|CASE|STYLE|")>0 THEN NOP 
  1283. OTHERWISE msgclass=0
  1284. END
  1285. arg2=DelWord(arg2,1,2)
  1286. END
  1287. specs.i=tprfs
  1288. font.i=tfontp
  1289. colour.i=tcolourp
  1290. END
  1291. END
  1292. WHEN comm="GETSTYLE" THEN
  1293. IF ar.1>=0 & ar.1<=Length(text) THEN
  1294. DO
  1295. msgclass=-1
  1296. i=ar.1
  1297. IF i=0 THEN
  1298. DO
  1299. specs.i=defspecs
  1300. font.i=deffont
  1301. colour.i=defcolour
  1302. END
  1303. SELECT
  1304. WHEN arg2="" THEN
  1305. res=specs.i colour.i font.i
  1306. WHEN arg2="FONT" THEN
  1307. res=SubStr(font.i,6)
  1308. WHEN arg2="COLOR"THEN
  1309. res=SubStr(colour.i,7)
  1310. WHEN Pos(arg2||"|","SIZE|WIDTH|OBLIQUE|")>0 THEN
  1311. res=Word(SubStr(specs.i,Pos(arg2,specs.i)+Length(arg2)+1),1)
  1312. WHEN Pos(arg2||"|","LEADING|POSITION|CASE|STYLE|")>0 THEN 
  1313. res=Word(SubStr(defspecs,Pos(arg2,defspecs)+Length(arg2)+1),1)
  1314. OTHERWISE msgclass=0
  1315. END
  1316. IF i=0 THEN
  1317. DO
  1318. specs.i=""
  1319. font.i=""
  1320. colour.i=""
  1321. END
  1322. END
  1323. WHEN comm="SET" THEN
  1324. DO
  1325. msgclass=-1
  1326. SELECT
  1327. WHEN Abbrev("PORT",arg1,1) THEN
  1328. DO
  1329. IF Show("P",ar.2) & Left(ar.2,Length(finalw))=finalw THEN rxport=ar.2
  1330. res=rxport
  1331. END
  1332. WHEN Abbrev("SCREEN",arg1,1) THEN
  1333. DO
  1334. IF arg2="" THEN
  1335. stitle=origscrtitle
  1336. ELSE
  1337. stitle=arg2
  1338. scrtitle=replacepat(replacepat(stitle,"@f",doc),"@i",info)
  1339. CALL SetWindowTitles(win,wintitle,scrtitle)
  1340. END
  1341. WHEN Abbrev("WINDOW",arg1,1) THEN
  1342. DO
  1343. IF arg2="" THEN
  1344. wtitle=origwintitle
  1345. ELSE
  1346. wtitle=arg2
  1347. wintitle=replacepat(replacepat(wtitle,"@f",doc),"@i",info)
  1348. CALL SetWindowTitles(win,wintitle,scrtitle)
  1349. END
  1350. WHEN Abbrev("ZIP",arg1,1) THEN
  1351. DO
  1352. res=zipped
  1353. zipped=(ar.2~=0)
  1354. IF zipped~=res THEN CALL ZipWindow(win)
  1355. END
  1356. OTHERWISE msgclass=0
  1357. END
  1358. END
  1359. WHEN comm="GET" THEN
  1360. DO
  1361. msgclass=-1
  1362. SELECT
  1363. WHEN Abbrev("PORT",arg1,1) THEN
  1364. IF portok THEN
  1365. res=rxport
  1366. ELSE
  1367. res=""
  1368. WHEN Abbrev("REQTOOLS",arg1,1) THEN res=lib.reqtools
  1369. WHEN Abbrev("SCREEN",arg1,1) THEN res=scrtitle
  1370. WHEN Abbrev("VERSION",arg1,1) THEN res=version
  1371. WHEN Abbrev("WINDOW",arg1,1) THEN res=wintitle
  1372. WHEN Abbrev("ZIP",arg1,1) THEN res=zipped
  1373. OTHERWISE msgclass=0
  1374. END
  1375. END
  1376. WHEN comm="PREFS" THEN
  1377. DO
  1378. msgclass=-1
  1379. IF Abbrev("STORE",arg1,1) THEN
  1380. DO
  1381. CALL savedef(1)
  1382. prefsstore=0
  1383. END
  1384. ELSE
  1385. IF Abbrev("RESET",arg1,1) THEN
  1386. DO
  1387. CALL loaddef(1)
  1388. prefsstore=1
  1389. END
  1390. ELSE
  1391. CALL loaddef(0)
  1392. END
  1393. WHEN comm="POPFRONT" THEN
  1394. DO
  1395. IF zipped THEN CALL ZipWindow(win)
  1396. CALL WindowToFront(win)
  1397. CALL ScreenToFront(scr)
  1398. CALL ActivateWindow(win)
  1399. msgclass=-1
  1400. END
  1401. WHEN comm="DIE" THEN
  1402. DO
  1403. msgclass=-1
  1404. res=lockcnt
  1405. IF lockcnt=0 THEN
  1406. DO
  1407. CALL Reply(msg,0)
  1408. IF ar.1~="" & Datatype(ar.1,"W") THEN
  1409. IF ar.2~="" THEN
  1410. DO
  1411. CALL message(ar.1,replacepat(ar.2,"_"," "),replacepat(ar.3,"_"," "))
  1412. IF ar.1=0 THEN CALL bye(0)
  1413. END
  1414. ELSE
  1415. CALL bye(ar.1)
  1416. ELSE
  1417. CALL bye(0)
  1418. END
  1419. END
  1420. WHEN comm="MESSAGE" THEN
  1421. DO
  1422. msgclass=-1
  1423. res=message(0,replacepat(ar.1,"_"," "),replacepat(ar.2,"_"," "),replacepat(ar.3,"_"," "))
  1424. END
  1425. WHEN comm="LOCK" THEN
  1426. DO
  1427. msgclass=-1
  1428. IF Abbrev("ON",arg1,2) THEN
  1429. lockcnt=lockcnt+1
  1430. ELSE
  1431. IF Abbrev("OFF",arg1,2) THEN
  1432. lockcnt=Max(0,lockcnt-1)
  1433. ELSE
  1434. IF Abbrev("RESET",arg1,1) THEN
  1435. lockcnt=0
  1436. res=lockcnt
  1437. END
  1438. WHEN comm="ABORT" THEN
  1439. msgclass=-1
  1440. WHEN comm="GO" THEN
  1441. DO
  1442. msgclass=IDCMP_GADGETUP
  1443. code=0
  1444. gadid=okgad*3
  1445. replymsg=msg
  1446. stilltoreply=1
  1447. RETURN
  1448. END
  1449. OTHERWISE NOP
  1450. END
  1451. IF msgclass=0 THEN 
  1452. CALL Reply(msg,5)
  1453. ELSE
  1454. CALL Reply(msg,ret,res)
  1455. IF msgclass=0 THEN CALL message(0,replacepat(rxcmderr,"@c",full))
  1456. RETURN
  1457. quickmessy: 
  1458. IF port=0 THEN RETURN 0
  1459. DO FOREVER
  1460. msg=GetPkt(portname)
  1461. IF msg=Null() THEN LEAVE
  1462. msgclass=GetArg(msg,0)
  1463. IF msgclass=IDCMP_CLOSEWINDOW THEN
  1464. closed=winclose
  1465. ELSE
  1466. IF msgclass=IDCMP_CHANGEWINDOW THEN
  1467. IF ~BitTst(D2C(GETVALUE(win,24,4,"N")),28) THEN CALL ZipWindow(win) 
  1468. IF Datatype(msgclass,"W") THEN
  1469. CALL Reply(msg,0)
  1470. ELSE
  1471. IF Upper(msgclass)="ABORT" THEN
  1472. DO
  1473. closed=winclose
  1474. CALL Reply(msg,0)
  1475. END
  1476. ELSE
  1477. CALL Reply(msg,1)
  1478. END
  1479. RETURN closed~=0
  1480. guiclean: 
  1481. IF cleangui THEN
  1482. DO
  1483. IF pubscr~=Null() THEN CALL UnLockPubScreen(Null(),pubscr)
  1484. IF win~=Null() THEN
  1485. DO
  1486. IF menustrip THEN CALL ClearMenuStrip(win)
  1487. CALL CloseWindow(win)
  1488. END
  1489. IF menu~=Null() THEN CALL FreeMenus(menu)
  1490. IF gad~=Null() THEN CALL FreeGadgets(gad)
  1491. IF scrvinfo~=Null() THEN CALL FreeVisualInfo(scrvinfo)
  1492. IF port THEN CALL ClosePort(portname)
  1493. port=0
  1494. DO id=1 TO gads
  1495. CALL FREETHIS(newgadx.id)
  1496. CALL FREETHIS(newgadxi.id)
  1497. CALL FREETHIS(newgadxb.id)
  1498. CALL FREETHIS(glabels.id)
  1499. END
  1500. CALL FREETHIS(newgadbv)
  1501. CALL FREETHIS(mptr)
  1502. CALL FREETHIS(wtagl)
  1503. CALL FREETHIS(glistptr)
  1504. CALL FREETHIS(pubnptr)
  1505. cleangui=0
  1506. END
  1507. RETURN
  1508. options: 
  1509. GetTextBlockPrefs "TEXTFLOW FLOWDIST TEXT"
  1510. PARSE VAR RESULT defflow deffld deftext
  1511. IF Left(deftext,1)=" " THEN deftext=SubStr(deftext,2) 
  1512. defprfs=""
  1513. IF defflow~="" THEN defprfs=defprfs "TEXTFLOW" defflow
  1514. IF deffld~="" THEN defprfs=defprfs "FLOWDIST" deffld
  1515. IF deftext~="" THEN defprfs=defprfs "TEXT" deftext
  1516. GetTextBlockTypePrefs "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  1517. PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  1518. defspecs="SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl
  1519. defcolour="COLOR" tcol
  1520. IF Left(tfont,1)=" " THEN
  1521. deffont="FONT"||tfont 
  1522. ELSE
  1523. deffont="FONT" tfont 
  1524. ssize=360
  1525. start="+0"
  1526. Status "PAGES"
  1527. docpages=RESULT
  1528. IF val.xgad~="" THEN ovalx=replacepat(val.xgad,",",".")
  1529. IF val.ygad~="" THEN ovaly=replacepat(val.ygad,",",".")
  1530. IF val.wgad~="" THEN ovalw=replacepat(val.wgad,",",".")
  1531. IF val.hgad~="" THEN ovalh=replacepat(val.hgad,",",".")
  1532. IF val.pgad~=0 THEN ovalp=Min(Max(val.pgad,1),docpages)
  1533. IF Left(text,Min(len.tgad,Length(text)))~=val.tgad THEN
  1534. DO
  1535. text=val.tgad
  1536. gadgettext=1
  1537. virtualtext=1
  1538. END
  1539. rescan=Length(text)=0
  1540. IF check.arc THEN ssize=SubStr("+-",cycle.arc+1,1)||val.arc
  1541. IF check.beg THEN start=SubStr(" -+",cycle.beg+1,1)||val.beg
  1542. titlemd=check.rot & (cycle.rot=3)
  1543. norrot=~check.rot | titlemd
  1544. IF norrot THEN
  1545. rrot=""
  1546. ELSE
  1547. IF cycle.rot=0 THEN
  1548. rrot=val.rot
  1549. ELSE
  1550. rrot=SubStr("-+",cycle.rot//2+1,1)||val.rot
  1551. dordim=check.spl
  1552. rdim=""
  1553. IF check.spl THEN rdim=SubStr("+-",cycle.spl+1,1)||val.spl
  1554. dohdim=check.siz | check.spl
  1555. hdim=""
  1556. IF check.siz THEN
  1557. hdim=SubStr("+-",cycle.siz+1,1)||val.siz
  1558. ELSE
  1559. IF check.spl THEN hdim=rdim
  1560. doresize=check.zoo
  1561. IF check.zoo THEN
  1562. DO
  1563. resize=val.zoo
  1564. resizek=SubStr("+|-",cycle.zoo+1,1)
  1565. END
  1566. adjust=cycle.adj
  1567. doadj=(adjust>0)
  1568. fillcol=cycle.ink//2
  1569. shadow=cycle.ink=3 | cycle.ink=4
  1570. resetcol=(cycle.ink=0) | shadow
  1571. attr=check.pat
  1572. wordmd=cycle.wrd>0
  1573. wordoff=SubStr(" 0 0+1-1",2*cycle.wrd+1,2)
  1574. charmd=~wordmd
  1575. IF ssize=0 THEN ssize=0.01 
  1576. absstart=0
  1577. IF Verify(Left(start,1),"+-","m")=0 THEN
  1578. DO
  1579. absstart=1
  1580. start=Max(Min(start,360),0)
  1581. END
  1582. ELSE
  1583. start=Max(Min(start,360),-360)
  1584. IF dordim THEN
  1585. rdim=Max(Min(rdim,100),-100)
  1586. ELSE
  1587. ssize=Max(Min(ssize,360),-360)
  1588. IF rdim=0 THEN rdim=0.01
  1589. IF dohdim THEN
  1590. hdim=Max(Min(hdim,100),-100)
  1591. ELSE
  1592. hdim=rdim
  1593. IF hdim=0 THEN hdim=0.01
  1594. IF doresize THEN
  1595. DO
  1596. resizex=Max(Min(resize,1000),5)/100
  1597. resizey=resizex
  1598. resize=resizex
  1599. IF resizek="|" THEN
  1600. resizex=1
  1601. ELSE
  1602. IF resizek="-" THEN resizey=1
  1603. END
  1604. drot=0
  1605. dodrot=0
  1606. IF rrot~="" THEN
  1607. IF Verify(Left(rrot,1),"+-","m")>0 THEN
  1608. DO
  1609. drot=Max(Min(rrot,360),-360)
  1610. rrot=""
  1611. norrot=1
  1612. END
  1613. ELSE
  1614. rrot=Max(Min(rrot,360),0)
  1615. RETURN
  1616. chosenobjs: 
  1617. ovalrescan=0
  1618. txtrescan=0
  1619. txt=0
  1620. oval=0
  1621. len=0
  1622. FirstObject "SELECTED"
  1623. o=RESULT
  1624. IF o~=0 THEN
  1625. DO
  1626. cnt=0
  1627. DO UNTIL o=0
  1628. gobj.cnt=o
  1629. NextObject o "SELECTED"
  1630. o=RESULT
  1631. cnt=cnt+1
  1632. END
  1633. DO i=0 TO cnt-1 WHILE oval=0 | txt=0
  1634. GetObjectType gobj.i
  1635. IF RESULT=7 THEN txt=gobj.i
  1636. IF RESULT=6 THEN oval=gobj.i
  1637. END
  1638. END
  1639. IF oval=0 THEN
  1640. oval=oldoval
  1641. ELSE
  1642. ovalrescan=1
  1643. IF gadgettext THEN len=Length(text)
  1644. IF gadgettext & ~(init | rescan) THEN txt=0
  1645. CALL getattr
  1646. Status "PARAPOS"
  1647. pos=RESULT
  1648. PARSE VAR pos para ppos x
  1649. Status "PARACHARS"
  1650. plen=RESULT
  1651. IF txt=0 & ~newattr THEN
  1652. IF Words(pos)=4  & (~gadgettext | rescan | init) THEN
  1653. DO
  1654. Extract
  1655. text=RESULT
  1656. len=Length(text)
  1657. IF C2X(Right(text,1))="0A" THEN len=len-1 
  1658. text=""
  1659. MoveToPara para ppos
  1660. virtualtext=0
  1661. ppos=0
  1662. END
  1663. ELSE
  1664. IF plen~=0 & (rescan | ((plen~=oldplen | para~=oldpara | ppos~=oldppos) & ~gadgettext)) THEN
  1665. DO
  1666. len=plen
  1667. text=""
  1668. virtualtext=0
  1669. IF ppos~=0 THEN MoveToPara para 0
  1670. ppos=0
  1671. END
  1672. IF txt>0 THEN
  1673. DO
  1674. GetTextBlockText txt
  1675. text=RESULT
  1676. len=Length(text)
  1677. END
  1678. IF len=0 & text~="" THEN
  1679. DO
  1680. objs=oldobjs
  1681. len=oldlen
  1682. END
  1683. ELSE
  1684. txtrescan=1
  1685. IF len=0 THEN 
  1686. DO
  1687. text=deftext
  1688. len=Length(text)
  1689. END
  1690. IF (len=0 | oval=0) & ~init THEN
  1691. DO
  1692. IF len=0 & text~="" THEN
  1693. DO
  1694. len=Length(text)
  1695. txtrescan=1
  1696. END
  1697. IF oval=0 & ovalx~="" & ovaly~="" & ovalw~="" & ovalh~="" & ovalp~="" THEN oval=-1
  1698. IF len=0 | oval=0 THEN
  1699. DO
  1700. CALL message(0,noselect)
  1701. RETURN 5
  1702. END
  1703. END
  1704. gadgettext=0
  1705. oldoval=oval
  1706. oldtxt=txt
  1707. oldlen=len
  1708. oldobjs=objs
  1709. oldpara=para
  1710. oldppos=ppos
  1711. oldplen=plen
  1712. redrawchars=1
  1713. RETURN 0
  1714. getattr: 
  1715. newattr=0
  1716. IF ~attr | init THEN RETURN 5
  1717. Status "PARAPOS"
  1718. pos=RESULT
  1719. IF Words(pos)~=4 THEN RETURN 5
  1720. PARSE VAR pos para ppos x
  1721. Extract
  1722. atext=RESULT
  1723. MoveToPara para ppos
  1724. alen=Length(atext)
  1725. IF C2X(Right(atext,1))="0A" THEN alen=alen-1 
  1726. IF alen=0 THEN RETURN 5
  1727. DO i=1 TO alen
  1728. Cursor "RIGHT"
  1729. aspecs.i=gettexttypespecs()
  1730. Status "FONTPATH"
  1731. afont.i="FONT" RESULT
  1732. Status "FONTCOLOR"
  1733. acolour.i="COLOR" RESULT
  1734. IF quickmessy() THEN
  1735. DO
  1736. CALL remobjs
  1737. oldlen=0
  1738. alen=0
  1739. oldobjs=0
  1740. RETURN 5
  1741. END
  1742. END
  1743. MoveToPara para 0
  1744. oldppos=0
  1745. oldpara=para
  1746. Status "PARACHARS"
  1747. oldplen=RESULT
  1748. newattr=1
  1749. RETURN 0
  1750. oval: 
  1751. IF ovalrescan THEN
  1752. DO
  1753. GetObjectRotation oval
  1754. orot=RESULT
  1755. IF orot~=0 THEN SetObjectRotation oval 0
  1756. GetObjectCoords oval
  1757. PARSE VAR RESULT ovalp ovalx ovaly ovalw ovalh
  1758. IF ovalw<0 THEN
  1759. DO
  1760. ovalx=ovalx+ovalw
  1761. ovalw=-ovalw
  1762. END
  1763. IF ovalh<0 THEN
  1764. DO
  1765. ovaly=ovaly+ovalh
  1766. ovalh=-ovalh
  1767. END
  1768. val.xgad=Left(ovalx,Min(len.xgad,Length(ovalx)))
  1769. val.ygad=Left(ovaly,Min(len.ygad,Length(ovaly)))
  1770. val.wgad=Left(ovalw,Min(len.wgad,Length(ovalw)))
  1771. val.hgad=replacepat(Left(ovalh,Min(len.hgad,Length(ovalh)))," ","") 
  1772. val.pgad=Left(ovalp,Min(len.pgad,Length(ovalp)))
  1773. IF deci="COMMA" THEN
  1774. DO
  1775. val.xgad=replacepat(val.xgad,".",",")
  1776. val.ygad=replacepat(val.ygad,".",",")
  1777. val.wgad=replacepat(val.wgad,".",",")
  1778. val.hgad=replacepat(val.hgad,".",",")
  1779. END
  1780. IF cleangui THEN
  1781. DO
  1782. CALL GT_SetGadgetAttrs(intgad.xgad,win,Null(),GTST_STRING,val.xgad)
  1783. CALL GT_SetGadgetAttrs(intgad.ygad,win,Null(),GTST_STRING,val.ygad)
  1784. CALL GT_SetGadgetAttrs(intgad.wgad,win,Null(),GTST_STRING,val.wgad)
  1785. CALL GT_SetGadgetAttrs(intgad.hgad,win,Null(),GTST_STRING,val.hgad)
  1786. CALL GT_SetGadgetAttrs(intgad.pgad,win,Null(),GTIN_NUMBER,val.pgad)
  1787. END
  1788. GetObjectParams oval "TEXTFLOW FLOWDIST LINECOLOR FILLCOLOR"
  1789. PARSE VAR RESULT flow fld ovlcol ovfcol
  1790. IF Left(flow,5)="Right" THEN
  1791. flow="Right"
  1792. ELSE
  1793. IF Left(flow,4)="Left" THEN flow="Left"
  1794. IF doresize THEN SetObjectCoords oval x+rx*(1-resizex) y+ry*(1-resizey) rx*resizex*2 ry*resizey*2
  1795. ovalscanned=1
  1796. END
  1797. IF oval~=0 THEN
  1798. DO
  1799. GetPageSetup "WIDTH" "HEIGHT"
  1800. PARSE VAR RESULT pagew pageh
  1801. rx=ovalw/2
  1802. ry=ovalh/2
  1803. xm=Min(ovalx,pagew)+rx
  1804. ym=Min(ovaly,pageh)+ry
  1805. page=ovalp
  1806. END
  1807. IF ~ovalscanned THEN 
  1808. DO
  1809. GetOvalPrefs "TEXTFLOW FLOWDIST LINECOLOR FILLCOLOR"
  1810. PARSE VAR RESULT flow fld ovlcol ovfcol
  1811. IF Left(flow,5)="Right" THEN
  1812. flow="Right"
  1813. ELSE
  1814. IF Left(flow,4)="Left" THEN flow="Left"
  1815. orot=0
  1816. END
  1817. IF fillcol THEN
  1818. ovcol=ovfcol
  1819. ELSE
  1820. ovcol=ovlcol
  1821. TextBlockPrefs "TEXTFLOW" flow "FLOWDIST" fld
  1822. IF ~resetcol THEN TextBlockTypePrefs "COLOR" ovcol
  1823. RETURN
  1824. text: 
  1825. usesheet=alen>0 & attr
  1826. IF ~(newtbprefs | txtrescan | dirtysize | (sheetused ^ usesheet) | newattr) THEN RETURN
  1827. CALL checkfonts
  1828. DO i=1 TO len
  1829. x=SubStr(text,i,1)
  1830. IF usesheet THEN 
  1831. DO
  1832. attrn=(i-1)//alen+1
  1833. TextBlockTypePrefs afont.attrn
  1834. base.i=getbase(afont.attrn)
  1835. IF resetcol THEN
  1836. TextBlockTypePrefs aspecs.attrn acolour.attrn
  1837. ELSE
  1838. TextBlockTypePrefs aspecs.attrn
  1839. END
  1840. ELSE
  1841. DO
  1842. IF newtbprefs THEN
  1843. DO
  1844. specs.i=defspecs
  1845. font.i=deffont
  1846. colour.i=defcolour
  1847. END
  1848. j=i-1
  1849. IF font.i~=font.j THEN
  1850. DO
  1851. TextBlockTypePrefs font.i
  1852. base.i=getbase(font.i)
  1853. END
  1854. ELSE
  1855. base.i=base.j
  1856. IF resetcol & (colour.i~=colour.j) THEN
  1857. TextBlockTypePrefs specs.i colour.i
  1858. ELSE
  1859. IF specs.i~=specs.j THEN TextBlockTypePrefs specs.i
  1860. END
  1861. IF Verify(x,'";= ',"M")  THEN x='"'||x||'"'
  1862. DrawTextBlock page xm ym x
  1863. obj.i=RESULT
  1864. objs=objs+1
  1865. IF check.mrel THEN Redraw
  1866. GetObjectCoords
  1867. PARSE VAR RESULT x x x objw.objs objh.objs
  1868. IF quickmessy() THEN
  1869. DO
  1870. CALL remobjs
  1871. dirtysize=1
  1872. oldlen=0
  1873. oldobjs=0
  1874. RETURN
  1875. END
  1876. END
  1877. sheetused=usesheet 
  1878. dirtysize=0
  1879. newtbprefs=0
  1880. redrawchars=0
  1881. RETURN
  1882. scan: 
  1883. IF ~(txtrescan | dirtytext) | len=0 THEN RETURN
  1884. IF txt>0 THEN
  1885. DO
  1886. redrawchars=0
  1887. GetObjectTypeSpecs txt "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  1888. PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  1889. prfs="SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl
  1890. colourp="COLOR" tcol
  1891. IF Left(tfont,1)~=" " THEN tfont=" "||tfont 
  1892. fontp="FONT"||tfont
  1893. GetObjectRotation txt
  1894. txtrot=RESULT
  1895. virtualtext=0
  1896. DO i=1 TO len
  1897. specs.i=prfs
  1898. font.i=fontp
  1899. colour.i=colourp
  1900. END
  1901. END
  1902. ELSE
  1903. IF virtualtext THEN
  1904. DO i=1 TO len
  1905. specs.i=defspecs
  1906. font.i=deffont
  1907. colour.i=defcolour
  1908. END
  1909. ELSE
  1910. IF text="" | dirtytext THEN
  1911. DO
  1912. text=""
  1913. DO i=1 TO len
  1914. Extract
  1915. x=rembad(RESULT)
  1916. text=text||x
  1917. Cursor "RIGHT"
  1918. specs.i=gettexttypespecs()
  1919. Status "FONTPATH"
  1920. font.i="FONT" RESULT
  1921. Status "FONTCOLOR"
  1922. colour.i="COLOR" RESULT
  1923. IF quickmessy() THEN
  1924. DO
  1925. CALL remobjs
  1926. oldlen=0
  1927. dirtytext=1
  1928. oldobjs=0
  1929. RETURN
  1930. END
  1931. END
  1932. MoveToPara para 0
  1933. val.tgad=Left(text,Min(len.tgad,Length(text)))
  1934. IF cleangui THEN CALL GT_SetGadgetAttrs(intgad.tgad,win,Null(),GTST_STRING,val.tgad)
  1935. END
  1936. dirtytext=0
  1937. IF text~="" THEN
  1938. DO
  1939. IF C2X(Right(text,1))="0A" THEN
  1940. DO
  1941. len=len-1
  1942. text=Left(text,len)
  1943. END
  1944. text=rembad(text)
  1945. old=val.tgad
  1946. val.tgad=Left(text,Min(len.tgad,Length(text)))
  1947. IF cleangui & val.tgad~=old THEN CALL GT_SetGadgetAttrs(intgad.tgad,win,Null(),GTST_STRING,val.tgad)
  1948. END
  1949. RETURN
  1950. initwrap: 
  1951. txtw=0
  1952. wnr=1
  1953. wordbeg=1
  1954. wordw=0
  1955. IF wordmd THEN
  1956. DO
  1957. wn=1
  1958. whi.wn=0
  1959. DO n=1 TO len
  1960. whi.wn=Max(objh.n,whi.wn)
  1961. IF SubStr(text,n,1)=" " | n=len THEN
  1962. DO
  1963. txtw=txtw+whi.wn
  1964. wn=wn+1
  1965. whi.wn=0
  1966. END
  1967. END
  1968. END
  1969. ELSE
  1970. DO n=1 TO len
  1971. txtw=txtw+objw.n
  1972. END
  1973. PI=3.141593
  1974. deg2rad=PI/180
  1975. smin=0.1 
  1976. rx=Max(rx,smin)
  1977. ry=Max(ry,smin)
  1978. sizerad=ssize*deg2rad
  1979. angstep=sizerad/txtw
  1980. IF doresize THEN angstep=angstep/resize
  1981. IF absstart THEN
  1982. angstart=start*deg2rad
  1983. ELSE
  1984. angstart=(ssize-360+start*2)/2*deg2rad
  1985. adone=angstart
  1986. flip=Sign(ssize)
  1987. ssize=ssize<0
  1988. fr=0
  1989. IF dordim THEN
  1990. DO
  1991. fr=(1-Abs(rdim)/100)/sizerad*Sign(rdim)
  1992. IF rdim<0 THEN
  1993. fr0=Abs(rdim)/100
  1994. ELSE
  1995. fr0=1
  1996. END
  1997. ELSE
  1998. qr=1
  1999. IF dohdim THEN
  2000. DO
  2001. fh=(1-Abs(hdim)/100)/sizerad*Sign(hdim)
  2002. IF hdim<0 THEN
  2003. fh0=Abs(hdim)/100
  2004. ELSE
  2005. fh0=1
  2006. END
  2007. ELSE
  2008. qh=1
  2009. wdone=0
  2010. o=0
  2011. rxx=rx
  2012. ryy=ry
  2013. IF doresize THEN
  2014. DO
  2015. rxx=rxx*resizex
  2016. ryy=ryy*resizey
  2017. END
  2018. sobjs=0
  2019. IF titlemd THEN
  2020. DO
  2021. CALL remobjs
  2022. redrawchars=1
  2023. END
  2024. CALL checkfonts
  2025. resetprefs=redrawchars | shadow
  2026. recalcchar=resetprefs | wordmd
  2027. usesheet=(alen>0) & attr
  2028. RETURN
  2029. wrap: 
  2030. CALL initwrap
  2031. DO n=1 TO len
  2032. IF recalcchar THEN
  2033. DO
  2034. char=SubStr(text,n,1)
  2035. IF Verify(char,'";= ',"M")  THEN char='"'||char||'"'
  2036. END
  2037. cw=objw.n
  2038. ch=objh.n
  2039. o=obj.n
  2040. IF resetprefs THEN
  2041. DO
  2042. IF usesheet THEN
  2043. DO
  2044. attrn=(n-1)//alen+1
  2045. TextBlockTypePrefs afont.attrn
  2046. base.n=getbase(afont.attrn)
  2047. IF resetcol THEN
  2048. TextBlockTypePrefs aspecs.attrn acolour.attrn
  2049. ELSE
  2050. TextBlockTypePrefs aspecs.attrn
  2051. END
  2052. ELSE
  2053. DO
  2054. m=n-1
  2055. IF font.n~=font.m THEN
  2056. DO
  2057. TextBlockTypePrefs font.n
  2058. base.n=getbase(font.n)
  2059. END
  2060. ELSE
  2061. base.n=base.m
  2062. IF resetcol & (colour.n~=colour.m | shadow) THEN
  2063. TextBlockTypePrefs specs.n colour.n
  2064. ELSE
  2065. IF specs.n~=specs.m THEN TextBlockTypePrefs specs.n
  2066. END
  2067. END
  2068. IF charmd THEN
  2069. DO
  2070. CALL position
  2071. m=n-1
  2072. base=base.n*cw/objw.n
  2073. x=rxx*Sin(f)*qr-cw/2+base*Sin(crot*deg2rad)
  2074. y=ryy*Cos(f)*qr+base*(1-Cos(crot*deg2rad))
  2075. END
  2076. IF titlemd THEN
  2077. DO
  2078. PARSE VAR specs.n "WIDTH" l
  2079. l=Word(l,1)*cw/objw.n
  2080. i=crot+45
  2081. k=(i-i//90)//360
  2082. j=45-i//360+k
  2083. i=X2D(SubStr(obl,Abs(j)+1,1))
  2084. crot=(360+k-Sign(j)*SubStr(obrot,i+i+1,2))//360
  2085. TextBlockTypePrefs "OBLIQUE" Trunc(10*i*Sign(j)/Sqrt(l)+0.5)
  2086. END
  2087. IF wordmd THEN
  2088. DO
  2089. x=wordw
  2090. y=(whi.wnr-objh.n)/2
  2091. wordw=wordw+objw.n
  2092. crot=0
  2093. END
  2094. IF redrawchars THEN
  2095. DO
  2096. DrawTextBlock page x+xm y+ym char
  2097. obj.n=RESULT
  2098. objs=objs+1
  2099. IF check.mrel THEN Redraw
  2100. o=obj.n
  2101. IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords o page x+xm y+ym cw ch
  2102. END
  2103. ELSE
  2104. SetObjectCoords o page x+xm y+ym cw ch
  2105. SetObjectRotation o crot
  2106. IF shadow THEN
  2107. DO
  2108. TextBlockTypePrefs "COLOR" ovcol
  2109. DrawTextBlock page x+xm+rx/10 y+ym+ry/10 char
  2110. sobj.n=RESULT
  2111. sobjs=sobjs+1
  2112. IF check.mrel THEN Redraw
  2113. IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords sobj.n page x+xm+rx/10 y+ym+ry/10 cw ch
  2114. SetObjectRotation sobj.n crot
  2115. END
  2116. IF wordmd THEN
  2117. IF char='" "' | n=len THEN CALL endofword
  2118. IF quickmessy() THEN
  2119. DO
  2120. CALL remobjs
  2121. RETURN
  2122. END
  2123. END
  2124. RETURN
  2125. getbase: 
  2126. ARG font
  2127. base=-1
  2128. DO ii=1 TO ftabsize
  2129. IF font=ftab.ii THEN base=fbase.ii
  2130. END
  2131. IF base=-1 THEN
  2132. DO
  2133. DrawTextBlock page xm ym "W"
  2134. o=RESULT
  2135. SetObjectRotation o 90
  2136. GetObjectCoords o
  2137. PARSE VAR RESULT op ox oy ow oh
  2138. DeleteObject o
  2139. base=Abs(oy-ym)-ow/2
  2140. ftabsize=ftabsize+1
  2141. ftab.ftabsize=font
  2142. fbase.ftabsize=base
  2143. END
  2144. RETURN base
  2145. position: 
  2146. IF doresize THEN
  2147. DO
  2148. cw=cw*resize
  2149. ch=ch*resize
  2150. END
  2151. f=angstart-angstep*(wdone+cw/2)
  2152. wdone=wdone+cw
  2153. IF dordim THEN qr=fr0+fr*(f-angstart)
  2154. IF dohdim THEN
  2155. DO
  2156. qh=fh0+fh*(f-angstart)
  2157. ch=Max(ch*qh,smin)
  2158. cw=Max(cw*qh,smin)
  2159. END
  2160. IF doadj THEN
  2161. IF adjust=4 THEN
  2162. DO
  2163. asize=1.1*cw/radius(adone,rxx,ryy,qr)
  2164. f=adone-asize/2*flip
  2165. adone=adone-asize*flip
  2166. END
  2167. ELSE
  2168. DO
  2169. carc=radius(f,rxx,ryy,qr)*angstep/qr
  2170. IF adjust=1 THEN ch=ch*carc
  2171. IF adjust=3 THEN ch=ch/Sqrt(carc)
  2172. cw=cw*carc
  2173. END
  2174. IF norrot THEN
  2175. crot=720-Trunc(Atan(ryy/rxx*Tan(f))/PI*180)+180*((Cos(f)>0)+ssize)+drot
  2176. ELSE
  2177. crot=rrot
  2178. crot=crot//360
  2179. RETURN
  2180. endofword: 
  2181. remspc=(char='" "')
  2182. IF remspc THEN wordw=wordw-objw.n
  2183. cw=whi.wnr
  2184. ch=1
  2185. CALL position
  2186. x=rxx*Sin(f)*qr-wordw/2
  2187. y=ryy*Cos(f)*qr-whi.wnr
  2188. x=x+wordoff*wordw/2*Sin(crot*deg2rad)
  2189. y=y-wordoff*wordw/2*Cos(crot*deg2rad)
  2190. crot=(crot+270)//360
  2191. IF shadow THEN
  2192. DO
  2193. SelectObject
  2194. DO i=wordbeg TO n
  2195. SelectObject sobj.i "MULTIPLE"
  2196. END
  2197. Group
  2198. CurrentObject
  2199. wsobj.wnr=RESULT
  2200. GetObjectCoords
  2201. SetObjectCoords wsobj.wnr page x+xm+rx/10 y+ym+ry/10 Word(RESULT,4)*ch Word(RESULT,5)*cw/whi.wnr
  2202. SetObjectRotation wsobj.wnr crot
  2203. END
  2204. SelectObject
  2205. DO i=wordbeg TO n-remspc
  2206. SelectObject obj.i "MULTIPLE"
  2207. END
  2208. Group
  2209. CurrentObject
  2210. wobj.wnr=RESULT
  2211. GetObjectCoords
  2212. SetObjectCoords wobj.wnr page x+xm y+ym Word(RESULT,4)*ch Word(RESULT,5)*cw/whi.wnr
  2213. SetObjectRotation wobj.wnr crot
  2214. IF remspc THEN DeleteObject obj.n
  2215. wordbeg=n+1
  2216. wnr=wnr+1
  2217. wordw=0
  2218. RETURN
  2219. checkfonts: 
  2220. IF ~xexists(SubStr(deffont,6)) THEN deffont=defaultfont
  2221. DO ii=1 TO len
  2222. jj=ii-1
  2223. IF font.ii~=font.jj THEN
  2224. IF ~xexists(SubStr(font.ii,6)) THEN font.ii=deffont
  2225. END
  2226. IF alen>0 THEN
  2227. DO ii=1 TO alen
  2228. jj=ii-1
  2229. IF font.ii~=font.jj THEN
  2230. IF ~xexists(SubStr(afont.ii,6)) THEN afont.ii=deffont
  2231. END
  2232. RETURN
  2233. group: 
  2234. SelectObject
  2235. IF wordmd THEN
  2236. DO n=1 TO wnr-1
  2237. SelectObject wobj.n "MULTIPLE"
  2238. END
  2239. ELSE
  2240. DO n=1 TO objs
  2241. SelectObject obj.n "MULTIPLE"
  2242. END
  2243. Group
  2244. i=RESULT
  2245. objs=0
  2246. IF orot~=0 THEN SetObjectRotation 0 orot
  2247. IF shadow THEN
  2248. DO
  2249. SelectObject
  2250. IF wordmd THEN
  2251. DO n=1 TO wnr-1
  2252. SelectObject wsobj.n "MULTIPLE"
  2253. END
  2254. ELSE
  2255. DO n=1 TO sobjs
  2256. SelectObject sobj.n "MULTIPLE"
  2257. END
  2258. Group
  2259. sobjs=0
  2260. IF orot~=0 THEN SetObjectRotation 0 orot
  2261. ObjectToBack 0
  2262. END
  2263. Redraw
  2264. RETURN
  2265. bye: 
  2266. PARSE ARG errnr
  2267. errtrap=-2
  2268. IF errnr=0 & lockcnt>0 THEN RETURN
  2269. IF stilltoreply THEN CALL Reply(replymsg,10)
  2270. CALL guiclean
  2271. IF Show("p",rxport) THEN
  2272. DO
  2273. CALL resetprefs
  2274. CALL remobjs
  2275. END
  2276. END
  2277. IF errnr>0 THEN 
  2278. DO
  2279. IF xexists(bugreport) THEN
  2280. DO
  2281. IF errormsg="" THEN errormsg="Error #"||errnr
  2282. ADDRESS COMMAND "Rx" bugreport version errormsg
  2283. END
  2284. END
  2285. EXIT errnr
  2286. RETURN
  2287. remobjs: 
  2288. IF objs>0 THEN
  2289. DO
  2290. IF wordmd THEN
  2291. DO n=1 TO wnr-1
  2292. SelectObject wobj.n
  2293. UnGroup
  2294. END
  2295. SelectObject
  2296. DO n=1 TO objs
  2297. SelectObject obj.n "MULTIPLE"
  2298. END
  2299. Group
  2300. DeleteObject
  2301. objs=0
  2302. END
  2303. IF sobjs>0 THEN
  2304. DO
  2305. SelectObject
  2306. IF wordmd THEN
  2307. DO n=1 TO wnr-1
  2308. SelectObject wsobj.n
  2309. UnGroup
  2310. END
  2311. DO n=1 TO sobjs
  2312. SelectObject sobj.n "MULTIPLE"
  2313. END
  2314. Group
  2315. DeleteObject
  2316. sobjs=0
  2317. END
  2318. RETURN
  2319. resetprefs: 
  2320. IF deci~="" THEN DocItemPrefs "DECIMAL PERIOD"
  2321. IF defprfs~="" THEN TextBlockPrefs defprfs
  2322. IF defspecs~="" | defcolour~="" THEN TextBlockTypePrefs defspecs defcolour
  2323. IF deffont~="" THEN
  2324. IF xexists(SubStr(deffont,6)) THEN TextBlockTypePrefs deffont
  2325. IF deci~="" THEN DocItemPrefs "DECIMAL" deci
  2326. RETURN
  2327. loaddef: 
  2328. ARG where
  2329. CALL loadtemp
  2330. IF where>0 THEN
  2331. DO
  2332. ok=0
  2333. DO i=where TO 3-where BY 3-where*2 UNTIL ok
  2334. IF preff.i~="" THEN
  2335. DO
  2336. ok=Open(prefs,preff.i,"R")
  2337. IF ok THEN
  2338. DO
  2339. default=ReadCh(prefs,prefsize+6)
  2340. CALL Close(prefs)
  2341. END
  2342. END
  2343. END
  2344. END
  2345. ELSE
  2346. default=""
  2347. IF Length(default)~=prefsize+6 | Left(default,6)~=prefsid | C2D(SubStr(default,5,2))~=prefsize THEN default=""
  2348. IF default="" THEN 
  2349. DO
  2350. winx=defwinx
  2351. winy=defwiny
  2352. DO id=1 TO agads
  2353. check.id=defchk.id
  2354. cycle.id=defcyc.id
  2355. val.id=defval.id
  2356. END
  2357. DO id=menuoff+1 TO menuoff+mchks
  2358. check.id=defchk.id
  2359. END
  2360. DO id=agads+1 TO agads+sgads
  2361. IF gtype.id=0 THEN
  2362. val.id=1
  2363. ELSE
  2364. val.id=""
  2365. END
  2366. END
  2367. ELSE 
  2368. DO
  2369. winx=C2D(SubStr(default,7,2))
  2370. winy=C2D(SubStr(default,9,2))
  2371. DO id=1 TO agads
  2372. i=id*4
  2373. check.id=C2D(SubStr(default,i+7,1))~=0
  2374. cycle.id=Min(Max(C2D(SubStr(default,i+8,1)),0),Abs(labs.id))
  2375. val.id=Min(Max(C2D(SubStr(default,i+9,2)),0),9999)
  2376. END
  2377. DO id=menuoff+1 TO menuoff+mchks
  2378. check.id=C2D(SubStr(default,id+agads*4-menuoff+10,1))~=0
  2379. END
  2380. END
  2381. CALL updategadgets
  2382. RETURN
  2383. savedef: 
  2384. ARG where
  2385. CALL savetemp
  2386. winx=GETVALUE(win,4,2,"N")
  2387. winy=GETVALUE(win,6,2,"N")
  2388. default=prefsid||D2C(winx,2)||D2C(winy,2)
  2389. DO id=1 TO agads
  2390. default=default||D2C(check.id,1)||D2C(cycle.id,1)||D2C(val.id,2)
  2391. END
  2392. DO id=menuoff+1 TO menuoff+mchks
  2393. default=default||D2C(check.id,1)
  2394. END
  2395. DO i=1 TO where
  2396. IF preff.i~="" THEN
  2397. DO
  2398. ok=Open(prefs,preff.i,"W")
  2399. IF ok THEN
  2400. DO
  2401. CALL WriteCh(prefs,default)
  2402. CALL Close(prefs)
  2403. END
  2404. END
  2405. END
  2406. RETURN
  2407. loadtemp: 
  2408. IF tempsize=0 THEN RETURN
  2409. ok=Open(prefs,temp,"R")
  2410. IF ok THEN
  2411. DO
  2412. default=ReadCh(prefs,tempsize)
  2413. i=1
  2414. IF Length(default)=tempsize THEN
  2415. DO id=agads+1 TO agads+sgads
  2416. val.id=replacepat(SubStr(default,i,len.id),D2C(0),"")
  2417. i=i+len.id
  2418. END
  2419. CALL Close(prefs)
  2420. END
  2421. RETURN
  2422. savetemp: 
  2423. IF tempsize=0 THEN RETURN
  2424. ok=Open(prefs,temp,"W")
  2425. IF ok THEN
  2426. DO
  2427. default=""
  2428. DO id=agads+1 TO agads+sgads
  2429. default=default||Left(val.id,len.id,D2C(0))
  2430. END
  2431. CALL WriteCh(prefs,default)
  2432. CALL Close(prefs)
  2433. END
  2434. RETURN
  2435. updategadgets: 
  2436. IF ~cleangui THEN RETURN
  2437. DO id=1 TO agads
  2438. IF labs.id>=0 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  2439. IF labs.id~=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,cycle.id)
  2440. IF labs.id>0 THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  2441. END
  2442. DO id=agads+1 TO agads+sgads
  2443. IF gtype.id>0 THEN
  2444. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,val.id)
  2445. ELSE
  2446. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  2447. END
  2448. CALL ClearMenuStrip(win)
  2449. item=GETVALUE(menu,18,4,"P")
  2450. DO n=menuoff+1 TO menuoff+mchks
  2451. flags=C2D(B2C(BitAnd(C2B(D2C(GETVALUE(item,12,2,"N"),2)),"1111111011111111")))+CHECKED*check.n
  2452. CALL SETVALUE(item,12,2,"N",flags,0)
  2453. item=GETVALUE(item,0,4,"P")
  2454. END
  2455. CALL ResetMenuStrip(win,menu)
  2456. RETURN
  2457. newdoc: 
  2458. IF portok THEN
  2459. DO
  2460. Status "FILENAME"
  2461. doc=RESULT
  2462. WinToFront
  2463. END
  2464. ELSE
  2465. doc="???"
  2466. IF doc="" THEN doc=unnamed
  2467. wintitle=replacepat(wtitle,"@f",doc)
  2468. scrtitle=replacepat(stitle,"@f",doc)
  2469. IF cleangui THEN
  2470. DO
  2471. CALL SetWindowTitles(win,wintitle,scrtitle)
  2472. IF ~windowpos THEN CALL WindowToFront(win)
  2473. CALL ActivateWindow(win)
  2474. END
  2475. RETURN
  2476. SYNTAX: 
  2477. et=ErrorText(RC)
  2478. ERROR:
  2479. err=RC
  2480. line=SIGL
  2481. IF errtrap=-1 THEN CALL bye(err)
  2482. IF errtrap=-2 THEN EXIT err
  2483. IF err=errtrap THEN
  2484. DO
  2485. errtrap=0
  2486. i=resume
  2487. DROP resume
  2488. trapped=1
  2489. SIGNAL VALUE i
  2490. END
  2491. RESUME:
  2492. errtrap=-1
  2493. IF et="" THEN et=fwerrtext.err
  2494. errormsg=replacepat(replacepat(replacepat(replacepat(errtext,"@n",err),"@l",line),"@t",et),"@s",SourceLine(line))
  2495. CALL message(err,errormsg)
  2496. CALL bye(err)
  2497. RETURN
  2498. BREAK_C: 
  2499. CALL bye(2)
  2500. RETURN
  2501.